home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / BORUSR2.ZIP;1 / SETCLR.PRG < prev   
Encoding:
Text File  |  1992-06-24  |  10.6 KB  |  210 lines
  1. *-------------------------------------------------------------------------------
  2. *      Program: SETCLR.PRG
  3. *       Author: George E. McMullen
  4. *             : Borland Technical Support
  5. *         Date: 10-18-91
  6. *     Function: Utilizes COLORCTL.BIN to custom set dBASE's color settings.
  7. *               This program gives you access to select 16 of 264,000+ possible
  8. *               colors on a VGA monitor.
  9. * Requirements: COLORCTL.BIN
  10. *               VGA color monitor
  11. *-- Ken Mayer's NOTE: I copied these programs from the Borland Technical Support
  12. *-- BBS, and have made VERY MINOR CHANGES. The only changes I have made are to
  13. *-- change the name of the MEM file created to CLRDESC.MEM, rather than 
  14. *-- which I use to store different color memory variables ... COLOR.MEM, and
  15. *-- I added a small bit to the screen display (N=Black ...)
  16. *--  Modified a tad, to reset the colors using the RECOLOR procedure in
  17. *--  PROC.PRG (Jay Parsons) ...
  18. *-------------------------------------------------------------------------------
  19.  
  20. * Setup Environment
  21. gl_escape=IIF(SET("ESCAPE")="ON","ON","OFF")
  22. SET ESCAPE OFF
  23. gl_talk=IIF(SET("TALK")="ON","ON","OFF")
  24. SET TALK OFF
  25. gl_echo=IIF(SET("ECHO")="ON","ON","OFF")
  26. SET ECHO OFF
  27. gl_status=IIF(SET("STATUS")="ON","ON","OFF")
  28. SET STATUS OFF
  29. gl_cursor=IIF(SET("CURSOR")="ON","ON","OFF")
  30. SET CURSOR OFF
  31. gl_color=SET("ATTRIBUTE")
  32. SET COLOR TO W+/N                      && Set color to bright white/black
  33. CLEAR                                  && Clear screen
  34.  
  35. *-------------------------------------------------------------------------------
  36. *-- check for BIN file, and all that ...
  37. *-------------------------------------------------------------------------------
  38. IF .NOT. FILE("colorctl.bin")          && Check for colorctl.bin
  39.   SET COLOR TO &gl_color               && Reset environment and display error
  40.   SET CURSOR &gl_cursor
  41.   SET STATUS &gl_status
  42.   ? CHR(7)+"Error: Could not locate COLORCTL.BIN"
  43.   SET ESCAPE &gl_escape
  44.   SET ECHO &gl_echo
  45.   SET TALK &gl_talk
  46.   RETURN
  47. ENDIF
  48.  
  49. *-------------------------------------------------------------------------------
  50. *-- COLORCTL.BIN exists, move on ...
  51. *-------------------------------------------------------------------------------
  52. PUBLIC ARRAY gl_colors[16,4]           && Public color array string
  53. DECLARE gl_colors[16,4]                && Initial color settings
  54. PUBLIC gl_dcolor                       && Dbase color setttings
  55. gl_dcolor="  N  B  G GB  R RB GR  W N+ B+ G+GB+ R+RB+GR+ W+"
  56. pv_index=1                             && Current index (color) number + 1
  57. pv_disp_color=""                       && Sample color display
  58. pv_new_color=""                        && New color setting
  59. pv_count1=1                            && Restore color index counter
  60. DO storedefaults                       && Get factory default settings
  61. LOAD colorctl.bin                      && Load colorctl.bin into memory
  62. CALL colorctl WITH '/R'                && Reset Default Settings
  63. DO draw_screen                         && Draw display screen
  64.  
  65. DO WHILE .T.                           && Main loop
  66.   DO CASE                              && Check for last key press
  67.     CASE LASTKEY()=4                   && <right arrow> Increase Index
  68.       pv_index=pv_index+IIF(pv_index=16,-15,1)
  69.     CASE LASTKEY()=19                  && <left arrow> Decrease Index
  70.       pv_index=pv_index-IIF(pv_index>1,1,-15)
  71.     CASE LASTKEY()=26                  && <home> Increase Red Gun
  72.       gl_colors[pv_index,2]=gl_colors[pv_index,2]+;
  73.                             IIF(gl_colors[pv_index,2]<63,1,-63)
  74.     CASE LASTKEY()=2                   && <end> Decrease Red Gun
  75.       gl_colors[pv_index,2]=gl_colors[pv_index,2]-;
  76.                             IIF(gl_colors[pv_index,2]>0,1,-63)
  77.     CASE LASTKEY()=5                   && <up arrow> Increase Green Gun
  78.       gl_colors[pv_index,3]=gl_colors[pv_index,3]+;
  79.                             IIF(gl_colors[pv_index,3]<63,1,-63)
  80.     CASE LASTKEY()=24                  && <down arrow> Decrease Green Gun
  81.       gl_colors[pv_index,3]=gl_colors[pv_index,3]-;
  82.                             IIF(gl_colors[pv_index,3]>0,1,-63)
  83.     CASE LASTKEY()=18                  && <pgup> Increase Blue Gun
  84.       gl_colors[pv_index,4]=gl_colors[pv_index,4]+;
  85.                             IIF(gl_colors[pv_index,4]<63,1,-63)
  86.     CASE LASTKEY()=3                   && <pgdn> Decrease Blue Gun
  87.       gl_colors[pv_index,4]=gl_colors[pv_index,4]-;
  88.                             IIF(gl_colors[pv_index,4]>0,1,-63)
  89.     CASE LASTKEY()=27                  && <ESC> key exit program
  90.       CALL colorctl WITH '/R'          && Reset Factory settings
  91.       EXIT                             && Exit Main Loop
  92.     CASE LASTKEY()=23                  && <ctrl-end> Save colors and exit
  93.       SET SAFE OFF                     && Set safety off
  94.       SAVE TO clrdesc ALL LIKE gl_colors 
  95.                                       && Save array gl_color to file clrdesc.mem
  96.       SET SAFE ON                      && Set safety on
  97.       EXIT                             && Exit without resetting colors
  98.     CASE LASTKEY()=29                  && <ctrl-home> Restore colors
  99.       IF FILE("clrdesc.mem")           && If CLRDESC.MEM exists...
  100.         RESTORE FROM clrdesc ADDITIVE  && Restore colors from clrdesc.mem
  101.         pv_count1=1                    && Restore index countere
  102.         DO WHILE pv_count1<17          && While index number < 17
  103.                                        && Build colorctl command
  104.           pv_new_color='"Index='+STR(gl_colors[pv_count1,1],2)+'",'+;
  105.                        '"Red='  +STR(gl_colors[pv_count1,2],2)+'",'+;
  106.                        '"Green='+STR(gl_colors[pv_count1,3],2)+'",'+;
  107.                        '"Blue=' +STR(gl_colors[pv_count1,4],2)+'"'
  108.           CALL colorctl WITH '/S',&pv_new_color  && Set new index color
  109.           pv_count1=pv_count1+1        && Increment index number
  110.         ENDDO
  111.       ENDIF
  112.   ENDCASE
  113.                                        && Build colorctl command
  114.   pv_new_color='"Index='+STR(gl_colors[pv_index,1],2)+'",'+;
  115.                '"Red='  +STR(gl_colors[pv_index,2],2)+'",'+;
  116.                '"Green='+STR(gl_colors[pv_index,3],2)+'",'+;
  117.                '"Blue=' +STR(gl_colors[pv_index,4],2)+'"'
  118.   CALL colorctl WITH '/S',&pv_new_color  && Set new index color
  119.   SET COLOR TO W+/N                    && Set color to bright white/black
  120.   @ 10,11 TO 16,31 DOUBLE              && Draw sample edit box
  121.   @ 11,12 SAY "Index:"+STR(gl_colors[pv_index,1],3)
  122.   @ 13,12 SAY "Red:  "+STR(gl_colors[pv_index,2],3)
  123.   @ 14,12 SAY "Green:"+STR(gl_colors[pv_index,3],3)
  124.   @ 15,12 SAY "Blue: "+STR(gl_colors[pv_index,4],3)
  125.   @ 11,24 TO 15,30 COLOR
  126.   pv_disp_color=SUBSTR(gl_dcolor,((pv_index-1)*3)+1,3)  && Get selected index
  127.   SET COLOR TO &pv_disp_color          && Display color box
  128.   @ 12,25 SAY REPL(CHR(219),5)
  129.   @ 13,25 SAY REPL(CHR(219),5)
  130.   @ 14,25 SAY REPL(CHR(219),5)
  131.   CLEAR TYPEAHEAD                      && Clear typeahead keyboard buffer
  132.   READ                                 && Wait for keypress
  133. ENDDO
  134.  
  135. *-- cleanup
  136. RELEASE module colorctl                && Release colorctl.bin from memory
  137. do ReColor with gl_color               && reset environment
  138. SET CURSOR &gl_cursor
  139. SET ECHO &gl_echo
  140. SET TALK &gl_talk
  141. SET ESCAPE &gl_escape
  142. SET STATUS &gl_status
  143. RETURN                                 && EOF() setclr.prg
  144.  
  145. *-------------------------------------------------------------------------------
  146. *-- End of Main Routine
  147. *-------------------------------------------------------------------------------
  148.  
  149. PROCEDURE draw_screen                  && draw display screen procedure
  150.    pv_count1=0                            && Index counter
  151.    pv_box_color=""                        && Current box color
  152.    DO WHIL pv_count1<16                   && While index number < 15
  153.      pv_box_color=SUBSTR(gl_dcolor,(pv_count1*3)+1,3)  && Get new box color
  154.      SET COLO TO W+/n                     && Set text color to bright white/black
  155.      @ 0,0 SAY "Color Index Number:"      && Draw display screen
  156.      @ 1,(pv_count1*5)+2 SAY STR(pv_count1,2)
  157.      @ 2,(pv_count1*5)+1 SAY SUBS(gl_dcolor,(pv_count1*3)+1,3)
  158.      @ 3,0 SAY REPL(CHR(205),80)
  159.       @ 6,0 SAY REPL(CHR(205),80)
  160.       SET COLOR TO &pv_box_color/n         && Set color for box
  161.       @ 4,pv_count1*5 SAY REPL(CHR(219),5) && Draw colored boxes
  162.       @ 5,pv_count1*5 SAY REPL(CHR(219),5)
  163.       pv_count1=pv_count1+1                && Increment index number
  164.     ENDDO
  165.     *-- NOTES added in to describe each "color"
  166.     @ 7,38 to 17,75 double
  167.     @ 8,40 say "Notes on 'default colors' codes:"
  168.     @ 9,40 say "N  = Black    N+  = Grey" 
  169.     @10,40 say "B  = Blue     B+  = Lt. Blue"
  170.     @11,40 say "G  = Green    G+  = Lt. Green"
  171.     @12,40 say "GB = Cyan     GB+ = Lt. Cyan"
  172.     @13,40 say "R  = Red      R+  = Pink"
  173.     @14,40 say "RB = Magenta  RB+ = Bright Magenta"
  174.     @15,40 say "GR = Brown    GR+ = Yellow"
  175.     @16,40 say "W  = White    W+  = Bright White"
  176.     
  177.               && Draw control panel
  178.     @ 19,0 SAY "Control Keys:    COLOR SELECTION     RED GUN     GREEN GUN    BLUE GUN"
  179.     @ 20,0 SAY "                =================    ========  =============  ========="
  180.     @ 21,0 SAY "                left/right arrows    Home/End  Up/Down arrow  PgUp/PgDn"
  181.     @ 22,0 SAY "                      <CTRL-END> to save colors to file CLRDESC.MEM"
  182.     @ 23,0 SAY "                     <CTRL-HOME> to load colors from file CLRDESC.MEM"
  183. RETURN
  184.  
  185. PROCEDURE storedefaults                && Store factory default color values
  186.  
  187.     * pv_default = "index number,red value,green value,blue value,index number,..."
  188.     pv_default="00,00,00,00,01,00,00,42,02,00,42,00,03,00,42,42,04,42,00,00,"+;
  189.                "05,42,00,42,06,42,21,00,07,42,42,42,08,21,21,21,09,21,21,63,"+;
  190.                "10,21,63,21,11,21,63,63,12,63,21,21,13,63,21,63,14,63,63,21,"+;
  191.                "15,63,63,63"
  192.     pv_count1=0                            && Index counter 0 - 15
  193.     pv_count2=0                            && Element counter
  194.     DO WHILE pv_count1<16                  && While index number < 16
  195.       pv_count2=0                          && Start at element 0 (index numeber)
  196.       DO WHILE pv_count2<4                 && While elements < 4
  197.                                            && Store the default settings into
  198.                                            &&   the global array gl_color
  199.         gl_colors[pv_count1+1,pv_count2+1]=;
  200.           VAL(SUBSTR(pv_default,(pv_count1*12)+1+(pv_count2*3),2))
  201.         pv_count2=pv_count2+1              && Increment the element counter
  202.       ENDDO
  203.       pv_count1=pv_count1+1                && Increment the index number
  204.     ENDDO
  205. RETURN
  206.  
  207. *-------------------------------------------------------------------------------
  208. *-- End of Program: SETCLR.PRG
  209. *-------------------------------------------------------------------------------
  210.